home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch4 / Styles2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-02  |  3.7 KB  |  109 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStyles2 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Styles2"
  6.    ClientHeight    =   4140
  7.    ClientLeft      =   1200
  8.    ClientTop       =   1440
  9.    ClientWidth     =   6690
  10.    LinkTopic       =   "Form1"
  11.    PaletteMode     =   1  'UseZOrder
  12.    ScaleHeight     =   207
  13.    ScaleMode       =   2  'Point
  14.    ScaleWidth      =   334.5
  15. Attribute VB_Name = "frmStyles2"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = False
  18. Attribute VB_PredeclaredId = True
  19. Attribute VB_Exposed = False
  20. Option Explicit
  21. Private Type TEXTMETRIC
  22.     tmHeight As Long
  23.     tmAscent As Long
  24.     tmDescent As Long
  25.     tmInternalLeading As Long
  26.     tmExternalLeading As Long
  27.     tmAveCharWidth As Long
  28.     tmMaxCharWidth As Long
  29.     tmWeight As Long
  30.     tmOverhang As Long
  31.     tmDigitizedAspectX As Long
  32.     tmDigitizedAspectY As Long
  33.     tmFirstChar As Byte
  34.     tmLastChar As Byte
  35.     tmDefaultChar As Byte
  36.     tmBreakChar As Byte
  37.     tmItalic As Byte
  38.     tmUnderlined As Byte
  39.     tmStruckOut As Byte
  40.     tmPitchAndFamily As Byte
  41.     tmCharSet As Byte
  42. End Type
  43. Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
  44. ' Draw a string on the form using randomly chosen
  45. ' ForeColor, size, bold, and italic values. Start
  46. ' the text at Y position min_y and keep it
  47. ' between the margins min_x and max_x.
  48. Private Sub RandomStyles(txt As String, min_size As Integer, max_size As Integer, min_x As Single, max_x As Single, min_y As Single)
  49. Dim length As Integer
  50. Dim pos1 As Integer
  51. Dim pos2 As Integer
  52. Dim new_word As String
  53. Dim clr As Long
  54. Dim y As Integer
  55. Dim font_names As Collection
  56. Dim text_metrics As TEXTMETRIC
  57. Dim ascent As Single
  58.     ' Erase the form.
  59.     Cls
  60.     CurrentX = min_x
  61.     y = 0
  62.     ' Make the list of font names.
  63.     Set font_names = New Collection
  64.     font_names.Add "Times New Roman"
  65.     font_names.Add "Courier New"
  66.     font_names.Add "Arial"
  67.     font_names.Add "MS Sans Serif"
  68.     ' Break the string into words.
  69.     length = Len(txt)
  70.     pos1 = 1
  71.     Do
  72.         ' Get the next word.
  73.         pos2 = InStr(pos1, txt, " ")
  74.         If pos2 = 0 Then
  75.             new_word = Mid$(txt, pos1)
  76.         Else
  77.             new_word = Mid$(txt, pos1, pos2 - pos1)
  78.         End If
  79.         pos1 = pos2 + 1
  80.         ' Randomly select a ForeColor.
  81.         clr = QBColor(Int(16 * Rnd))
  82.         If clr = BackColor Then clr = vbBlack
  83.         ForeColor = clr
  84.         ' Randomly pick Font properties.
  85.         ' (The Underline and Strikethrough
  86.         ' properties make things too cluttered.)
  87.         Font.Name = font_names(Int(font_names.Count * Rnd + 1))
  88.         Font.Size = Int((max_size - min_size + 1) * Rnd + min_size)
  89.         Font.Bold = (Int(2 * Rnd) = 1)
  90.         Font.Italic = (Int(2 * Rnd) = 1)
  91.         ' If the word won't fit, start a new line.
  92.         If CurrentX + TextWidth(new_word) > max_x Then
  93.             CurrentX = min_x
  94.             y = y + 1.25 * max_size
  95.         End If
  96.         ' Get the font's metrics.
  97.         GetTextMetrics hdc, text_metrics
  98.         ascent = ScaleY(text_metrics.tmAscent, vbPixels, ScaleMode)
  99.         ' Display the text.
  100.         CurrentY = y + max_size - ascent
  101.         Print new_word; " ";
  102.     Loop While pos2 > 0
  103. End Sub
  104. ' Call RandomStyles to redraw the text string.
  105. Private Sub Form_Resize()
  106. Const txt = "If you draw some text, modify the Font object, and then draw more text, the two pieces of text will be displayed in different styles. Similarly you can change a form or picture box's ForeColor property to produce text of different colors."
  107.     RandomStyles txt, 10, 20, 0, ScaleWidth, 0
  108. End Sub
  109.